home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / cadence.zip / VOL2NO2.ZIP / COGO218.LSP next >
Lisp/Scheme  |  1986-12-06  |  4KB  |  96 lines
  1. ; COGO218.lsp         rev: 6 Dec 86           
  2. ; =======================================================
  3. ; Written by Mark Carvalho
  4. ; Copyright (c) 1986  CADMAN, Inc.
  5. ; (303) 452-8440      PO Box 147, Denver, CO  80201
  6. ; =======================================================
  7. ;
  8. ; This set of functions (for Autocad 2.18) will perform the basic coordinate 
  9. ; geometry functions: line (based on direction and distance of travel) and 
  10. ; arc (based on direction and included angle of travel).  Each function will 
  11. ; automatically generate the line or arc, given user prompted input, and will 
  12. ; then draw the junction circle at the starting point.  This is accomplished in 
  13. ; supplementary command format, not menu format.  Two command functions are 
  14. ; given for the arc conditions, one allowing for angle input in decimal degrees,
  15. ; the other for the standard degrees/minutes/seconds format. 
  16. ;
  17. ; A pline is used for the arc commands because AutoCAD will give only radius, 
  18. ; start, and endpoint data for regular arcs, whereas the radius, area enclosed, 
  19. ; start point, start angle, end point, end angle, and length along the arc are 
  20. ; all given for a pline arc.  The opposite is true for pline versus line.  
  21. ; AutoCAD reports only the start and end points for a pline, whereas for a line 
  22. ; it gives the start point, end point, length, and angle for a regular line.  
  23. ; Therefore the LGO command uses a line for its operation.
  24. ;
  25. ;   Hint:  Most parcel survey data is given in Degrees/Minutes/Seconds 
  26. ;          format and DECIMAL FEET, and AutoCAD 2.18 accepts only decimal 
  27. ;          inches.  Therefore the most efficient way to input the data with 
  28. ;          these commands is to input all data as prompted, giving DECIMAL FEET 
  29. ;          as the response to the distance prompts.  When the parcel is 
  30. ;          completed, make the entire parcel a block and reinsert it as a 
  31. ;          *block, giving it a scale factor of 12; then the parcel will be in 
  32. ;          feet and inches format. 
  33. ;
  34. ;Functions:   AGO  - Arc coordinate GeOmetry 
  35. ;             LGO  - bearing Line coordinate GeOmetry 
  36. ;             DAGO - Decimal Arc coordinate GeOmetry 
  37. ;             CRAD - Circle RADius 
  38. ; -------------------------------------------------------
  39. ; 
  40. (setvar "CMDECHO" 0) 
  41.  
  42. (defun C:AGO ()
  43. (if (= crad nil) (setq crad (getdist "\nRadius for junction CIRCLE: ")))
  44. (setq p1 (osnap
  45.     (getpoint "\nSelect line END to start ARC FROM (do not osnap): ") "endp"))
  46. (command "line" p1)
  47. (setq p2 (getpoint "\nSide to offset towards: "))
  48. (command ())
  49. (setq a1 (+ pi (angle p2 (osnap p1 "perp"))))
  50. (setq ang (getangle "\nArc's included ANGLE: "))
  51. (setq ans (getint "\nDirection? CCW=1 CW=2 <1>: "))
  52. (if (= ans 2) (setq ang (* -1.0 ang)))
  53. (setq rad (getdist "\nArc's RADIUS: "))
  54. (setq p2 (polar p1 a1 rad))
  55. (command "pline" p1 "A" "CE" p2 "A" (angtos ang 1 4) "")
  56. (command "circle" p1 crad)
  57. )
  58.  
  59. (defun C:LGO ()
  60. (if (= crad nil) (setq crad (getdist "\nRadius for junction CIRCLE: ")))
  61. (setq p1 (getpoint "\nPlace to START bearing LINE: "))
  62. (setq dist (getdist p1 "\nLENGTH of bearing line: "))
  63. (setq quad (getint "\nAngle QUADRANT NE=1 NW=2 SW=3 SE=4 <1>: "))
  64. (setq ang (getangle "\nBearing ANGLE: "))
  65. (cond ((or (= quad nil) (= quad 1)) (setq ang (- (* 0.5 pi) ang )))
  66.       ((= quad 2) (setq ang (+ (* 0.5 pi) ang )))
  67.       ((= quad 3) (setq ang (- (* 1.5 pi) ang )))
  68.       ((= quad 4) (setq ang (+ (* 1.5 pi) ang )))
  69. )
  70. (command "line" p1 (polar p1 ang dist) "")
  71. (command "circle" p1 crad)
  72. )
  73.  
  74. (defun C:CRAD ()
  75. (setq crad (getdist "\nRadius for junction CIRCLE: "))
  76. )
  77.  
  78. (defun C:DAGO ()
  79. (if (= crad nil) (setq crad (getdist "\nRadius for junction CIRCLE: ")))
  80. (setq p1 (osnap
  81.     (getpoint "\nSelect line END to start ARC FROM (do not osnap): ") "endp"))
  82. (command "line" p1)
  83. (setq p2 (getpoint "\nSide to offset towards: "))
  84. (command ())
  85. (setq a1 (+ pi (angle p2 (osnap p1 "perp"))))
  86. (setq ang (getangle "\nArc's included ANGLE: "))
  87. (setq ans (getint "\nDirection? CCW=1 CW=2 <1>: "))
  88. (if (= ans 2) (setq ang (* -1.0 ang)))
  89. (setq rad (getdist "\nArc's RADIUS: "))
  90. (setq p2 (polar p1 a1 rad))
  91. (command "pline" p1 "A" "CE" p2 "A" (angtos ang 0 4) "")
  92. (command "circle" p1 crad)
  93. )
  94.  
  95.  
  96.